perm filename READX.F4[PAX,LCS] blob sn#573423 filedate 1981-03-12 generic text, type T, neo UTF8
00100		COMMON /PTR/INP(72)
00200		DIMENSION FORM2(5),FORMT(5),NUMS(30)
00300		DATA FORMT(1)/'('/,FORM2/'A1,','A2,','A3,','A4,','A5,'/
00400		1, FORM3/'30I)'/
00450		IDEV=1
00500	1	FORMAT(72A1)
00600	CC	IEXT='MS'
00700	CC	ACCEPT 1,INP
00800		KEND=0
00900	C IDEV=DEVICE NUMBER (1=DSK, 5=TTY)
00950		CALL IFILE(1,'MVT2')
01000	99	READ(IDEV,1,END=12)INP
01100		DO 2 K=2,72
01200		IF(INP(K).EQ.' ')GO TO 3
01300	2	IF(INP(K).EQ.'.')GO TO 4
01400	3	FORMT(3)=FORM3
01500		FORMT(4)=' '
01600		FORMT(5)=' '
01700	5	FORMT(2)=FORM2(K-1)
01800		REREAD FORMT,NAME,NUMS
01900		GO TO 10
02000	4	FORMT(3)=FORM2(1)
02100	C  CATCHES DOT
02200		DO 7 N=K+1,72
02300	7	IF(INP(N).EQ.' ')GO TO 8
02400	8	FORMT(4)=FORM2(N-K-1)
02500		FORMT(5)=FORM3
02600		FORMT(2)=FORM2(K-1)
02700		REREAD FORMT,NAME,K,IEXT,NUMS
02800		CALL LO2UP(IEXT)
02900	10	CALL LO2UP(NAME)
02925	100	FORMAT(1XA5,30I2)
02950		TYPE 100,NAME,NUMS
03000		GO TO 99
03100	12	KEND=-1
03200		END
03300	
03400		SUBROUTINE LO2UP(J)
03500	C CONVERTS ALL LOWER CASE TO UPPER CASE.
03600		J=J.AND..NOT.((J/2).AND."201004020100)
03700		END
03800	
03900		FUNCTION TSIG(Q,J)
04000		DIMENSION Q(1)
04100		TSIG=IFIX(Q(J+5)*100.0+Q(J+6)+.5)
04200	C COMBINES METER NUMS.  (2/4 = 204. ETC.)
04300		END